perm filename LOOP.FAI[XX,LCS]12 blob
sn#217881 filedate 1976-06-01 generic text, type T, neo UTF8
00100 TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
00200 ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
00300 ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN,NALF,BOX
00400 EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
00500 EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,HOMNEW,RMOD,RINP,SIZ
00510 EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE
00600 DEFINE FIXX(N)
00700 < JUMPGE N,.+5
00800 MOVNS N
00900 KAFIX N,233000
01000 MOVNS N
01100 CAIA
01200 KAFIX N,233000 > ; TO KAFIX IT LIKE 'IFIX' DOES.
01300 ; DIMENSION N(1)
01400 MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
01600 RC←14 ↔ NX←15 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
01700 LOOP: 0 ; DO 1 NN=I+L,J+L,K
01800 MOVE 1,@4(16)
01900 SUB 1,@3(16) ; MM IS IN 1
02000 MOVE 2,@(16)
02100 ADD 2,@3(16) ;I+L -- NN, 1ST TIME
02200 MOVE 3,@1(16)
02300 ADD 3,@3(16) ;J+L
02400 MOVE 4,@2(16) ;K
02500 HRRZI 5,@5(16) ; ADR. OF N
02600 ADDI 2,-1(5) ; N(NN)
02700 ADDI 3,-1(5)
02800 JUMPL 4,LP3 ; JUMP IF NEG. INCR.
02900 HRRM 1,.+1 ; ADD IN MM
03000 LP1: MOVE 6,(2)
03100 MOVEM 6,(2) ;N(NN)=N(NN+MM)
03200 CAIGE 2,(3)
03300 AOJA 2,LP1
03400 JRA 16,6(16)
03500 LP3: HRRM 1,.+1
03600 LP2: MOVE 6,(2) ;NEG. INCR.
03700 MOVEM 6,(2)
03800 CAILE 2,(3)
03900 SOJA 2,LP2
04000 JRA 16,6(16) ; END
04100
04200 PLACE: 0 ; FUNCTION PLACE(X)
04300 ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
04400 ; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04500 MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
04600 FADR 2,RMOD+=9 ;END
04700 MOVMS 2
04800 MOVE 0,.COMM.+=12 ;R11
04900 FSBR 0,2
05000 JRA 16,1(16)
05100
05200 FINDIT: 0 ; FUNCTION FINDIT(N)
05300 SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
05400 HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05500 ;; HRRZI 2,PTR ; FINDIT=0
05600 ;; ADDI 1,(2) ; L=PWDS(N)
05700 ;; MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
05800 ;; FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
05900 ;; HRRZI 3,XRN ;377 FINDIT=-1
06000 ;; ADDI 3,(2) ; END
06100 ;; MOVE 5,(3) ; RN(L+1)
06200 MOVE 2,PTR-1(1) ;THESE 3 REPLACE ABOVE
06300 ;X FIXX(2)
06400 MOVE 5,XRN(2)
06500 CAME 5,[1.0]
06600 JRST FNEG
06700 MOVEM 2,PTR+=251 ; SENDS BACK A NUM IN L
06800 ;; MOVE 5,1(3) ;RN(L+2)
06900 MOVE 5,XRN+1(2)
07000 CAME 5,.COMM.
07100 FNEG: SETO
07200 JRA 16,1(16)
07300
07400 DPYNEW: 0 ; SUBROUTINE DPYNEW
07500 JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07600 JUMP [1] ; CALL ACCPOG(1)
07700 MOVE 2,DPY+=4251 ; IF(IGO.GT.0)RETURN
07800 JUMPG 2,DB ; CALL DPYOUT(1)
07900 JSA 16,DPYOUT ; END
08000 JUMP [1]
08100 DB: JRA 16,(16)
08200
08300 MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
08400 HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
08500 MOVE 5,@1(16) ; I
08600 ADD 2,5 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
08700 ADD 2,@2(16) ; DIMENSION R(1)
08800 MOVE 3,-1(2) ; Y=R(JY+I)
08900 MOVM 4,3 ; Z=ABS(Y)
09000 CAMGE 4,[=100.0] ; IF(Z.LT.100.)GO TO 1
09100 JRST MV1
09200 CAML 5,[6]
09300 JRST MV1 ; IF(I.GT.5)GO TO 1
09400 ;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
09500 JSA 16,AMOD ; Y=AMOD(Y,100.)
09600 JUMP 3
09700 JUMP [=100.0] ; 0 HAS Y
09800 MOVE 5,@4(16) ; X=Y+W
09900 FADR 5,0
10000 MOVM 6,5 ; Z=Z-ABS(Y)+ABS(X)
10100 MOVMS 0 ;C PUTS ALL INTO POSITIVE
10200 FSBR 4,0
10300 FADR 4,6
10400 SKIPGE 5 ; IF(X)Z=-Z
10500 MOVNS 4 ; Z
10600 JRST MV2 ; GO TO 2
10700 MV1: FADR 3,@4(16) ;1 Z=Y+W
10800 MOVE 4,3 ; Z NOW IN 4
10900 MV2: HRRZI 3,@(16) ;2 R(L+I)=Z
11000 ADD 3,@3(16)
11100 ADD 3,@1(16)
11200 MOVEM 4,-1(3) ; PUT IT IN R(L+I)
11300 JRA 16,5(16) ; END
11400
11500 MVBX: 0 ; SUBROUTINE MVBX(I)
11600 ; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
11700 MOVE 2,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
11800 ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
11900 ;; HRRZI 4,XRN
12000 ;; ADDI 2,(4)
12100 ;; MOVE 3,-1(2) ; R(JY+I)
12200 MOVE 3,XRN-1(2)
12300 FSBR 3,.COMM.+5
12400 FMPR 3,.COMM.+=25 ; *RDIS
12500 FADR 3,.COMM.+=9 ; +R8
12600 MOVE 2,@(16)
12700 ADD 2,.COMM.+=24 ; + L
12800 ;; ADDI 2,(4)
12900 ;; MOVEM 3,-1(2) ;R(L+I)
13000 MOVEM 3,XRN-1(2)
13100 JRA 16,1(16)
13200
13300 JUGGLE: 0 ; SUBROUTINE JUGGLE
13400 ; IMPLICIT INTEGER(A-Z)
13500 ; REAL PWDS,RN
13600 ; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
13700 ; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
13800 SOS PTR+=250 ;ITEM=ITEM-1
13900 HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
14000 ;C I-IX IS WD CNT OF NEW ITEM
14100 ADD 15,DPY+=4250
14200 MOVE 14,-1(15)
14300 FIXX(14)
14400 ADDI 14,3 ; JX
14500 MOVE 13,PTR+=253 ;JY=IX
14600 MOVE 11,PTR+=252 ; I
14700 SUB 11,13
14800 SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
14900 JUMPL 11,J2751 ;IF(Z)2751,172,751
15000 JUMPE 11,J172
15100 MOVE 5,PTR+=252 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
15200 SUBI 5,1
15300 MOVE 10,DPY+=4250
15400 ADD 10,14
15500 JSA 16,LOOP
15600 JUMP 5
15700 JUMP 10
15800 JUMP [-1]
15900 JUMP 11
16000 JUMP [0]
16100 JUMP XRN
16200 ADD 13,11 ;JY=IX+Z
16300 JRST J172 ;GO TO 172
16400 J2751: ADD 14,DPY+=4250 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
16500 ADD 14,11
16600 MOVE 5,11
16700 ADD 5,PTR+=253
16800 SOJ 5,
16900 MOVN 10,11
17000 JSA 16,LOOP
17100 JUMP 14
17200 JUMP 5
17300 JUMP [1]
17400 JUMP [0]
17500 JUMP 10
17600 JUMP XRN
17700 ;;J172: HRRZI 12,XRN ; 172 J=RN(JY)+2
17800 ;; ADDI 12,(13) ; JY
17900 J172: MOVE 12,XRN-1(13)
18000 ;; MOVE 12,-1(12) ;RN(JY)
18100 FIXX(12)
18200 ADDI 12,2 ; J IS IN 12
18300 JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
18400 JUMP [0]
18500 JUMP 12
18600 JUMP [1]
18700 JUMP DPY+=4250 ; MEDIT
18800 JUMP 13 ; JY
18900 JUMP XRN
19000 MOVE 12,PTR+=253 ; I=IX+Z
19100 ADD 12,11 ; Z IS IN 11
19200 MOVEM 12,PTR+=252
19300 MOVE 12,PTR+=250 ; 1751 X=ITEM+1
19400 AOJ 12, ; X IS IN 12
19500 HRRZI 13,DPY+=4000 ; JX=WDS(X22+1)-WDS(X22)
19600 ADD 13,DL
19700 MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
19800 SUB 14,-1(13) ;JX IN 14
19900 HRRZI 10,DPY+=4000 ; J=WDS(X+1)-WDS(X)
20000 ADDI 10,(12)
20100 MOVE 7,(10) ;WDS(X+1)
20200 SUB 7,-1(10) ;J IN 7
20300 MOVEM 7,MVBX ; STORE J
20400 SUB 7,14 ; Y=J-JX
20500 MOVE 14,-1(10) ; JX=WDS(X)+Y+1
20600 ADD 14,7
20700 AOJ 14, ; JX IN 14
20800 JUMPL 7,J2851 ; IF(Y)2851,182,282
20900 JUMPE 7,J182
21000 MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
21100 ADDI 15,2 ; ARG 1
21200 MOVE 6,-1(13) ; ARG 2
21300 JSA 16,LOOP
21400 JUMP 15
21500 JUMP 6
21600 JUMP [-1]
21700 JUMP 7 ; Y
21800 JUMP [0]
21900 JUMP DPY
22000 JRST J182 ; GO TO 182
22100 J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
22200 ADD 14,7 ;+Y
22300 ADDI 14,1 ; ARG 1
22400 MOVE 5,-1(10) ;WDS(X)
22500 ADD 5,7
22600 ADDI 5,1 ; ARG 2
22700 MOVNM 7,MVBEAM ; -Y IS STORED
22800 JSA 16,LOOP
22900 JUMP 14
23000 JUMP 5
23100 JUMP [1]
23200 JUMP [0]
23300 JUMP MVBEAM
23400 JUMP DPY
23500 MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
23600 ADDI 14,1 ; JX IN 14
23700 J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
23800 ADDI 5,1 ;WDS(X22)+1
23900 JSA 16,LOOP
24000 JUMP [1]
24100 JUMP MVBX
24200 JUMP [1]
24300 JUMP 5
24400 JUMP 14
24500 JUMP DPY
24600 MOVE 2,DL ; DO 183 K=X22+1,X
24700 ;; HRRZI 5,DPY+=4000 ; 183 WDS(K)=WDS(K)+Y
24800 ;; ADD 5,2
24900 HRRZI 3,PTR
25000 ADDI 3,(2)
25100 ;; TLC 11,232000 ; FLOAT Z
25200 ;; FADR 11,11
25300 J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
25400 ADDM 11,(3) ; PWDS(K)=PWDS(K)+Z
25500 AOJ 3, ;UPDATE PWDS AND WDS
25600 J184: JUMPE 7,J185
25700 ADDM 7,(13)
25800 AOJ 13,
25900 J185: CAIGE 2,(12)
26000 AOJA 2,J183
26100 ;; HRRZI 2,DPY+=4000 ;ST(2)=WDS(X)
26200 ;; ADDI 2,(12) ;WDS(X+1) ADR.
26300 ;; MOVE 2,-1(2)
26400 MOVE 2,DPY+=3999(12)
26500 ;; HRRZI 3,DPY
26600 ;; MOVEM 2,1(3)
26700 MOVEM 2,DPY+1
26800 SETZM DL ;X22=0
26900 JRA 16,(16)
27000
27100 SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
27200 MOVEI 2,2 ;DIMENSION RPOS(2,200)
27300 S3: MOVE 6,2 ;(K=L HERE)
27400 SETO 11, ;L=2
27500 HRRZI 3,@(16) ;3 J=-1
27600 MOVE 4,2 ;RX=RPOS(1,L-1)
27700 SUBI 4,1 ;L-1
27800 IMULI 4,2
27900 ADDI 4,(3)
28000 MOVE 5,-2(4) ;RX
28100 S2: MOVE 7,6 ; DO 2 K=L,M
28200 ;; LSH 7,1 ;IF(RPOS(1,K).GE.RX)GO TO 2
28300 IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
28400 ADDI 7,(3)
28500 CAMG 5,-2(7)
28600 JRST S1 ; CONTINUE
28700 MOVE 5,-2(7) ; RX=RPOS(1,K)
28800 ;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
28900 MOVE 11,6 ;J=K
29000 S1: CAMGE 6,@1(16) ;2 CONTINUE
29100 AOJA 6,S2
29200 JUMPL 11,S4 ;IF(J)GO TO 4
29300 MOVE 12,2 ;K=L-1
29400 SOS 12
29500 IMULI 12,2 ;(K*2)
29600 ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
29700 MOVE 10,-2(12)
29800 ;; LSH 11,1 ;MULTS BY 2 (LEFT SHIFT)
29900 IMULI 11,2
30000 ADD 11,3
30100 EXCH 10,-2(11)
30200 MOVEM 10,-2(12)
30300 MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
30400 EXCH 10,-1(11)
30500 MOVEM 10,-1(12)
30600 S4: CAMGE 2,@1(16) ;4 L=L+1
30700 AOJA 2,S3 ;IF(L.LE.M)GO TO 3
30800 JRA 16,2(16) ;END
30900
31000 XNOTE: 0 ;FUNCTION XNOTE(J)
31100 MOVE 3,@(16) ;COMMON/XRN/RN(4000)
31200 IMULI 3,12 ;DIMENSION R(10,80)
31300 ;; ADDI 3,XRN+=2993 ;EQUIVALENCE (R,RN(3001))
31400 ;; MOVE 2,(3) ;XNOTE=AMOD(R(4,J),100.)
31500 MOVE 2,RINP-7(3)
31600 JSA 16,AMOD
31700 JUMP 2
31800 JUMP [=100.0]
31900 JRA 16,1(16) ;END
32000
32100 BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
32200 ;C FOR AUTOMATIC BEAMS.
32300 MOVEI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
32400 ADDB 2,@(16) ;J=J+2
32500 ;; MOVE 3,@3(16)
32600 MOVE 4,@1(16)
32700 SUB 4,@3(16) ;L-N
32800 MOVE 5,@2(16)
32900 SUB 5,@3(16) ;K-N
33000 ;; HRRZI 6,SCM
33100 ;; ADDI 6,(2)
33200 TLC 4,232000
33300 FADR 4,4 ;FLOATS IT
33400 MOVEM 4,SC+16(2) ;VX(J-1)=L-N
33500 ;; MOVEM 4,SCM-2(2) ****** WAS V(J-1)
33550 ;**** A LIMIT OF 25 BEAMS PER LINE.
33600 TLC 5,232000
33700 FADR 5,5 ;FLOATS IT
33800 MOVEM 5,SC+17(2) ;VX(J)=K-N
33900 ;; MOVEM 5,SCM-1(2)
34000 JRA 16,4(16)
34100
34200 UPDATE: 0 ; SUBROUTINE UPDATE(I)
34300 ;; HRRZI 3,XRN ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
34400 ;; ADD 3,PTR+=252 ;RN(IS)=I
34500 MOVE 3,PTR+=252
34600 MOVE 2,@(16)
34700 TLC 2,232000 ;FLOAT I
34800 FADR 2,2
34900 ;; MOVEM 2,-1(3)
35000 MOVEM 2,XRN-1(3)
35100 ;; MOVE 2,PTR+=252
35200 ;; ADD 2,@(16)
35300 ;; ADDI 2,3
35400 ;; MOVEM 2,PTR+=252 ;IS=IS+I+3
35500 MOVE 2,@(16)
35600 ADDI 2,3
35700 ADDM 2,PTR+=252
35800 JRA 16,1(16)
35900
36000 IK: 0 ;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
36100 JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
36200 NEWR: 0 ; SUBROUTINE NEWR
36300 MOVE A,SC+=70 ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
36400 CAIE A,1 ;COMMON/XRN/RN(4000)
36500 JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
36600 MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
36700 MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
36800 MOVE JT,PTR+=250 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
36900 MOVEM JT,JIT ;DIMENSION R(10,80)
37000 N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
37100 MOVEM IS,PTR+=252
37200 MOVE 14,[9999.0]
37300 MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
37400 ADDI JT,1 ;IK=IS
37500 MOVEM JT,PTR+=250 ;HOMER=ITEM
37600 MOVEI K,=10 ;1 IS=IK
37700 MOVE IZ,SCX+=41 ;ITEM=HOMER+1 ******************** WAS +=33
37800 IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
37900 ;;N2: HRRZI R,XRN+=2997 ;DO 2 K=1,IZ
38000 ;;;;N2: MOVE R,XRN+=2997(K) ;DO 2 K=1,IZ
38100 ;; ADD R,K ;IF(R(8,K).EQ.9999.)GO TO 2
38200 ;; MOVE R,(R)
38300 ;;;; CAMN R,[=9999.0]
38400 N2: CAMN 14,RINP-3(K)
38500 JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
38600 SETO IEND, ;C JUMP FOR BEAM CONT.
38700 ;; HRRZI L,XRN ;IEND=-1
38800 ;; ADD L,PTR+=252 ;RN(IS+3)=0
38900 ;; SETZM 2(L)
39000 ;; SETZM 1(L) ;RN(IS+2)=0
39100 MOVE L,PTR+=252
39200 SETZM XRN+2(L)
39300 SETZM XRN+1(L)
39400 MOVEI L,=9 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
39500 ;;N3: HRRZI R,XRN+=3000 ;DO 3 L=9,1,-1
39600 N3: HRRZI R,RINP(K) ;DO 3 L=9,1,-1
39700 ;; ADDI R,(K) ;A=R(L,K)
39800 ADDI R,(L)
39900 MOVE A,-13(R) ;(OCTAL)=-11
40000 JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
40100 JUMPN A,NX3 ;IF(IEND)GO TO 3
40200 JRST NN3
40300 NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
40400 ;;NX4: HRRZI R,XRN
40500 ;; ADD R,PTR+=252 ;RN(IS+L)=A
40600 ;; ADDI R,(L)
40700 ;; MOVEM A,-1(R)
40800 NX4: MOVE R,PTR+=252
40900 ADDI R,(L)
41000 MOVEM A,XRN-1(R)
41100 NN3: CAILE L,1 ;3 CONTINUE
41200 SOJA L,N3
41300 CAIGE IEND,3
41400 MOVEI IEND,3
41500 MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
41600 SUBI 15,2
41700 JSA 16,UPDATE ;CALL UPDATE(IEND-2)
41800 JUMP 15
41900 NN2: CAML K,IZ ;2 CONTINUE
42000 JRA 16,(16) ;END
42100 ADDI K,=10
42200 JRST N2
42300
42400 CNT: 0
42500 MSSLUP: 0
42600 SETZ 1, ;161 CNT=1
42700 SETZ 2,
42800 L5543: MOVE 3,.COMM.+4(2) ;DO 5543 K=1,9
42900 ;; ADDI 3,(2)
43000 ;; MOVE 3,(3) ;RA=RJQ(K)
43100 SKIPE 3 ;IF(RA.NE.0)CNT=K
43200 MOVE 1,2
43300 ;; MOVEI 4,RRJJ+1 ;5543 RJJ(K)=RA
43400 ;; ADDI 4,(2)
43500 ;; MOVEM 3,(4)
43600 MOVEM 3,RRJJ+1(2)
43700 CAIG 2,7 ; LOOP BACK?
43800 AOJA 2,L5543
43900 AOJ 1,
44000 MOVEM 1,CNT ;REMEMBERS CNT
44100 JRA 16,(16)
44200
44300 LUP2: 0
44400 ;; MOVEI 1,XRN ;261 RN(I)=CNT
44500 ;; ADD 1,PTR+=252
44600 MOVE 2,CNT
44700 TLC 2,232000
44800 FADR 2,2 ;FLOATS IT
44900 ;; MOVEM 2,-1(1)
45000 MOVE 1,PTR+=252
45100 MOVEM 2,XRN-1(1)
45200 MOVE 2,.COMM.+1 ;RN(I+1)=JA
45300 TLC 2,232000
45400 FADR 2,2
45500 ;; MOVEM 2,(1)
45600 ;; MOVE 2,PTR+=252 ;I=I+2
45700 ;; ADDI 2,2
45800 ;; MOVEM 2,PTR+=252
45900 MOVEM 2,XRN(1)
46000 ADDI 1,2
46100 MOVEM 1,PTR+=252
46200 MOVE 3,.COMM. ;RN(I)=R2
46300 ;; MOVEM 3,1(1)
46400 MOVEM 3,XRN-1(1)
46500 ;; NOT USED NOW! IF(RD.NE.0)RN(I)=RD
46600 ;;C TO SAVE NOTE NUMBS IN P2.
46700 SETZ 5, ;DO 4554 K=1,CNT
46800 L4554: MOVE 2,.COMM.+4(5)
46900 ;;L4554: MOVEI 2,.COMM.+4 ;(RJQ)
47000 ;; ADDI 2,(5)
47100 ;; MOVE 2,(2)
47200 ;; MOVEI 3,XRN(5)
47300 ;; ADDI 3,(5)
47400 ;; ADD 3,PTR+=252
47500 ;; MOVEM 2,(3) ;4554 RN(I+K)=RJQ(K)
47600 MOVE 3,1
47700 ADDI 3,(5)
47800 MOVEM 2,XRN(3)
47900 AOJ 5,
48000 CAME 5,CNT
48100 JRST L4554
48200 AOJ 5,
48300 ;; ADD 5,PTR+=252
48400 ADDM 5,PTR+=252
48500 ;; MOVEM 5,PTR+=252 ;3554 I=CNT+1+I
48600 JRA 16,(16)
48700
48800 ;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
48900 ;; SUBROUTINE HOMER
49000 ;; IMPLICIT INTEGER(A-Q,S-Z)
49100 ;; REAL PWDS,DISX,A,B,PLACE,STFF
49200 ;; COMMON /STF/RSTFAC(-3/4),RSTJ2
49300 ;; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
49400 ;; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
49500 ;; COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
49600 ;; EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
49700 ;; 1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
49800 ;; 1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
49900 HOMER: 0 ; IF(JA.EQ.6)GO TO 9
50000 MOVE MM,.COMM.+1
50100 CAIN MM,6
50200 JRST H9
50300 SKIPE .COMM.+=14 ;IF(R13.NE.0)GO TO 10
50400 JRST H10 ; FOR GENL HOMING; WORDS; BEAMS; STEMS;
50500 MOVE RC,[6.0] ;RC=6 USE THIS NEXT AND AT 197
50600 SKIPN .COMM.+=24 ;IF(J3.EQ.0)GO TO 197
50700 JRST H197 ; NEXT TO HOME IN ON NOTE ON DIFFERENT STAFF.
50800
50900 MOVE PTR+=250 ;JJ2=ITEM (FOR RETURN WITH NO CHANGE)
51000 MOVEM POSI+=8
51100 ; IF(JA.EQ.6)GO TO 9
51200 MOVE K,.COMM. ;JJ2=R2
51300 FIXX(K)
51400 MOVE K,PTR-1(K) ;K=PWDS(J2) ← BEAM PTR.
51500 ;; MOVE XRN(K)
51600 ;; CAME [6.0] ; IS IT REALLY A BEAM?
51700 CAME RC,XRN(K) ; IS IT REALLY A BEAM?
51800 JRA 16,(16) ;NO - GO BACK
51900 ;******* 19, ITEM# OF BEAM, +1 FOR STAFF ABOVE, -1 FOR BELOW.
52000 MOVEM K,.COMM.+3 ;SAVES IT IN J2
52100 MOVE R,XRN+5(K) ; POS OF RT. SIDE OF BEAM SAVED IN R
52200 SETZ MM, ; 0=BEAM STEM ↓
52300 MOVE XRN+6(K) ;RN(K+7) STEM DIR.
52400 CAMGE [20.0] ;IS IT UP?
52500 SETO MM, ; YES -1=BEAM STEM ↑
52600 MOVEM MM,ALF+=21 ;SAVE IT 'TIL AFTER AMOD
52700 MOVE A,XRN+1(K) ;SAVE BEAM'S STAFF #
52800 MOVEM A,ALF+8
52900 MOVE 5,A
53000 MOVE .COMM.+4 ; 2ND PARAM
53100 CAMN [0.1] ; USE .1 FOR SAME STAFF
53200 SETZ
53300 MOVEM .COMM.+4
53400 FADR A,
53500 MOVEM A,ALF+5 ; SAVE NOTES' STAFF #
53600 SETZ L, ; NEXT IS SEARCH LOOP
53700 MOVE IZ,[1.0]
53800 ;; MOVE NN,.COMM.+5 ;IF(R4.EQ.0)R4=3.0 SETS HOMING RANGE
53900 SKIPN NN,.COMM.+5
54000 MOVE NN,[3.0]
54100 H401: MOVE JK,PTR(L) ; JK=KWDS(L)
54200 CAMN 5,XRN+1(JK) ;IF RN(JK).NE.STF, SKIP
54300 JRST .+3
54400 CAME A,XRN+1(JK) ; LOOKS ON BOTH STAVES FOR END NOTE OF BEAM
54500 JRST H402
54600 CAME IZ,XRN(JK) ; IS IT A NOTE?
54700 JRST H402 ; NO
54800 MOVE XRN+2(JK) ;POS OF NOTE
54900 FSBR R ; NOTE POS - RT. SIDE OF BEAM
55000 MOVM ; ABS. VALUE
55100 CAMG NN ; 3.0 RANGE FOR HOMING - P4
55200 JRST H403 ; NO CLOSE ENOUGH
55300 H402: AOJ L, ; ADD ONE FOR LOOP
55400 CAMGE L,PTR+=250 ; UP TO ITEM YET?
55500 JRST H401
55600
55700 JRA 16,(16) ;COULDN'T HOME IN.
55800 H403: MOVEM JK,ALF ; FOR JK=KWDS(L) -- NT PTR. SAVE IT FOR HOMNEW
55900 MOVE NX,[1.0]
56000 MOVE XRN+3(JK) ;RN(JK+4) NOTE HGT.
56100 CAML [80.0]
56200 MOVE NX,[0.6] ; MINI-NOTE
56300 MOVEM NX,STF+=8 ; PUT IT IN RSTJ2
56400
56500 SETZM ALF+=17 ;NOTE STEM -- 0=↓
56600 MOVE XRN+4(JK) ;RN(JK+5)
56700 CAMGE [20.0]
56800 SETOM ALF+=17 ; STEM -- -1=↑
56900 MOVE 0,XRN+6(K) ;RG=-(AMOD(RN(K+7),10.)-1.)[*NX]*11./7.
57000 MOVEM 0,ALF+=13 ;RN(K+7)
57100 JSA 16,AMOD
57200 JUMP ALF+=13
57300 JUMP [=10.0]
57400 FSBR 0,[=1.0]
57500 FMPR 0,[=1.5714]
57600 FMPR 0,NX ; *RMINI (.6)
57700 MOVEM 0,ALF+=15 ;RG SAVED IN ALF+=15
57800 ; VERTICAL SPACE FOR THE NUMB. OF BEAMS
57900 MOVE JK,ALF+8 ;GET BEAM'S STAFF #
58000 FIXX(JK) ; JK IS IN JK
58100 MOVEM JK,ALF+=8 ;SAVE IT
58200 ; THE STAFF NUMS. JK=BEAM JT=NOTE
58300 MOVE IS,STF+3(JK) ;R3=RSTFAC(JK) R3 IS IN 'IS'
58400 FMPR IS,NX ; *RMINI (.6)
58500 ;; MOVE IZ,STF+3(JT) ;R9=RSTFAC(JT)/R3
58600 FMPR IS,[=2.43959732] ;R8=R3*14.54/5.96
58700 MOVEM IS,ALF+=14
58800 ; R8=WIDTH OF NOTE
58900
59000 ;************************************************
59100 MOVE MM,ALF+5
59200 FIXX(MM) ; THESE FOR FORTR. ROUTINE
59300 MOVEM MM,ALF+5
59400 JSA 16,HOMNEW ;CALL FORTRAN ROUTINE FOR NOW.
59500 JRA 16,(16)
59600
59700
59800
59900 ; ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
60000 ; NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
60100 H197: SETOM POSI+=8 ;197 JJ2=-1
60200 MOVE R,.COMM. ;R3=R2
60300 MOVEM R,DPYNEW
60350 MOVE IZ,[6.0]
60400 SETZ K, ;DO 191 K=1,ITEM
60500 H191: MOVEM K,LOOP ;SAVE K L=PWDS(K)
60600 MOVE L,PTR(K) ; L IS PWDS(K+1)
60700 ;IF(RN(L+1).NE.6)GO TO 191 -- NO ADJUSTMENT IF P10.NE.0
60800 MOVEI R,XRN(L)
60900 CAME IZ,(R)
61200 JRST HX191
61300 MOVE JK,DPYNEW ;IF(RN(L+2).EQ.R3)GO TO 77
61400 CAMN JK,1(R)
61500 JRST H77
61600 CAMGE JK,[=5.0] ;IF(R3.LT.5.)GO TO 191
61700 JRST HX191 ; TYPE AD 99 FOR ALL STAVES (=19 99)
61800 H77: MOVE JK,-1(R) ;77
61900 CAMN JK,[=8.0] ;IF(RN(L).EQ.8)GO TO 191
62000 JRST HX191
62100 MOVE JK,6(R) ;IF(RN(L+7).LT.10.)GO TO 191
62200 CAMGE JK,[=10.0] ;C FINDS BEAMS.
62300 JRST HX191
62400 FDVR JK,[=10.0] ;X=RG/10.
62500 FIXX(JK) ;C STEM DIRECT.
62600 MOVEM JK,XNOTE ;X SAVED IN XNOTE
62700 MOVE JK,1(R) ;R2=RN(L+2)
62800 MOVEM JK,.COMM. ; USED IN 'FINDIT'
62900 MOVE A,2(R) ;A=RN(L+3)-.01
63000 FSBR A,[=0.01]
63100 MOVEM A,NEWR ;SAVE A IN NEWR
63200 MOVM RC,3(R) ;RC=ABS(RN(L+4)) RC USED AFTER H192
63300 FSBR RC,[90.0] ;NEG=MAXI SIZE, POS=MINI SIZE BEAMS.
63400 MOVE JK,5(R) ;B=RN(L+6)+.01
63500 FADR JK,[=0.01] ;C POS 1 AND 2
63600 MOVEM JK,BAUTO ;B SAVED IN BAUTO
63700 FSBR JK,A ;DISX=B-A
63800 MOVEM JK,UPDATE ;DISX SAVED IN UPDATE
63900 ; DISTANCE IN REAL STEPS
64000 MOVEM R,MVBX ;SAVE LOC OF RN(L+1)
64100 MOVE 0,3(R)
64200 MOVEM 0,JUGGLE
64300 JSA 16,AMOD ;RF=AMOD(RN(L+4),100.0)
64400 JUMP JUGGLE
64500 JUMP [=100.0]
64600 MOVEM 0,JUGGLE; THIS IS RF!!!!
64700 ; NOTE 2
64800 MOVE JK,MVBX
64900 MOVE JK,4(JK)
65000 MOVEM JK,MSSLUP
65100 JSA 16,AMOD ;RB=AMOD(RN(L+5),100.0)
65200 JUMP MSSLUP
65300 JUMP [=100.0] ;0 WILL HAVE RB!!!
65400 FSBR 0,JUGGLE
65500 MOVEM 0,SORT2 ;RD SAVED IN ALF+=9 -- RD=RB-RF
65600 MOVEI NX,1
65700 H192: JSA 16,FINDIT ;IF(FINDIT(N))GO TO 192
65800 JUMP NX
65900 JUMPL 0,HX192
66000 MOVEI R,XRN ;IF(RN(L).EQ.8)GO TO 192
66100 ADD R,PTR+=251 ;LOC OF RN(L+1)
66200 MOVE JK,-1(R)
66300 CAMN JK,[=8.0]
66500 JRST HX192
66510 JUMPGE RC,.+4 ;JUMP IF MINI-BEAMS. THEY WILL LOOK FOR MININOTES
66600 MOVE JK,7(R) ;IF(RN(L+8).GE.1000.)GO TO 192
66700 CAML JK,[=1000.0]
66800 JRST HX192 ; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
66900 ; FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
66910 MOVE A,2(R) ;RC=RN(L+3)
66920 MOVE 5(R) ;GET P6
66930 CAMGE [10.0] ;IF(P6.LT.10)GO TO HX4
66940 JRST HX4
66950 MOVE JK,[2.44] ; THE SIZE OF A NOTE
66960 MOVE L,1(R) ; GET STAFF #
66970 FIXX(L)
66980 FMPR JK,STF+3(L) ;*RSTFAC(L)
66990 CAML [20.0] ;IF(P6.GE.20) SZ=-SZ
67000 MOVNS JK
67110 FADR A,JK ;PUT SHIFTED POS. INTO A
67190 HX4: CAMGE A,NEWR ;IF(RC.LT.A)GO TO 192
67200 JRST HX192
67300 CAMLE A,BAUTO ;IF(RC.GT.B)GO TO 192
67400 JRST HX192 ; WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
67500 MOVE JK,4(R) ;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
67600 FDVR JK,[=10.0]
67700 FIXX(JK)
67800 CAME JK,XNOTE
67900 JRST HX192
68000 FSBR A,NEWR ;RC=RC-A
68100 MOVEM A,MVBEAM;SAVES RC
68200 MOVEM R,MVBX ;SAVE LOC OF RN(L+1)
68300 MOVE 0,3(R)
68400 MOVEM 0,MSSLUP
68500 JSA 16,AMOD ;193 RE=AMOD(RN(L+4),100.0)
68600 JUMP MSSLUP
68700 JUMP [=100.0]
68800 MOVEM 0,ALF+3 ;RE SAVE HERE
68900 MOVE JK,SORT2 ;RC=RD*RC/DISX+RF
69000 FMPR JK,MVBEAM ;*RC
69100 FDVR JK,UPDATE ;/DISX
69200 FADR JK,JUGGLE ;+RF
69300 MOVEM JK,MVBEAM ;RC=
69400 MOVE JK,MVBX
69500 MOVE JK,6(JK) ;RG=RN(L+7)
69600 MOVEM JK,ALF+4 ;SAVE RG
69700 JSA 16,AMOD ;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
69800 JUMP ALF+4
69900 JUMP [=10.0]
70000 MOVEM 0,LUP2
70100 JSA 16,AMOD
70200 JUMP ALF+4
70300 JUMP [=1.0]
70400 FSBR 0,LUP2
70500 FADR 0,ALF+4
70600 MOVE L,MVBX
70700 MOVEM 0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
70800 ; FRACTIONAL NOTE #
70900 MOVE R,MVBEAM ;195 RA=RC-RE
71000 FSBR R,ALF+3
71100 MOVE JK,XNOTE ;IF(X.EQ.2)RA=-RA
71200 CAIN JK,2
71300 MOVNS R
71400 ;; SKIPN R ;IF(RA.EQ.0)RA=999.
71500 ;; MOVE R,[=999.0]
71510 MOVE 0,7(L) ;IF(RN(L+8).GT.999)RA=RA+1000. FOR MINI-NOTES
71520 CAMLE 0,[999.0]
71530 FADR R,[1000.0]
71600 MOVEM R,7(L) ;196 RN(L+8)=RA
71700 ; FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
71800 SKIPGE POSI+=8
71900 MOVEM NX,POSI+=8 ; SAVES # OF LOWEST ITEM FOUND
72000 HX192: CAMGE NX,PTR+=250 ;192 CONTINUE
72100 AOJA NX,H192
72200 HX191: MOVE K,LOOP ;191 CONTINUE
72300 CAMGE K,PTR+=250
72400 AOJA K,H191
72500 JRA 16,(16) ;RETURN
72600 H9: SKIPGE .COMM.+=32 ;9 IF(J11.LT.0)RETURN
72700 JRA 16,(16) ; IF P11=-1 NO HOMING
72800 MOVM R,.COMM.+=28 ; X=IABS(J7)/10 CC X=R7/10.
72900 IDIVI R,=10 ;;;FDVR R,[=10.0]
73000 ;;; FIXX(R)
73100 ;;; SKIPGE R ;IF(X)X=-X
73200 ;;; MOVNS R
73300 MOVEM R,XNOTE ;X SAVED IN XNOTE
73400 ; X IS STEM DIRECTION
73500 ;;; MOVE L,.COMM.+=10 ;RA=R9
73600 ; R9= POS3
73700 MOVNI RC,1 ;RC=-1
73800 SKIPE .COMM.+=10 ;IF(R9.NE.0)RC=-2
73900 MOVNI RC,2
74000 MOVE JK,.COMM.+=31 ;IF(J10/10.EQ.3)RC=-3
74100 IDIVI JK,=10 ;JT HAS REMAINDER (AC4)
74200 CAIN JK,3
74300 MOVNI RC,3 ; RC=0 ESCAPES FRCOM LOOP.
74400 ;;; JRST HZ10
74500 ;;;H10: SETZ RC, ;FOR P13=1
74600 ; HOMING RANGE FOR BEAMS
74700 ;;;HZ10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
74800 H10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
74900 JUMPN IS,HX10
75000 MOVE IS,[=2.9]
75100 MOVEM IS,.COMM.+=12 ; IF P11.NE.0 RANGE IS CHANGED FROM 2
75200 HX10: MOVE IZ,.COMM.+1 ; IF(JA.EQ.5)RC=-1
75300 CAIN IZ,5
75400 MOVNI RC,1
75500 MOVEI K,1
75510 MOVE L,.COMM.+1 ; JA IS NOW IN L
75600 H361: JSA 16,FINDIT ;DO 361 K=1,ITEM
75700 JUMP K
75800 JUMPL 0,HX361 ;IF(FINDIT(K))GO TO 361
75900 ; SKIPS NOTES ON WRONG LINE
76000 MOVEI R,XRN ;RD=RN(L+3)
76100 ADD R,PTR+=251 ;LOC OF RN(L+1)
76200 MOVE A,2(R) ;RD IN A
76300 MOVEM A,RMOD+=9 ;1 IF(JA.NE.6)GO TO 177
76700 MOVE JK,4(R) ;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
76760 CAIE L,6
76770 JRST H177
76800 FDVR JK,[=10.0]
76900 FIXX(JK)
77000 CAME JK,XNOTE
77100 JRST HX361
77200 H177: JSA 16,PLACE ;177 IF(PLACE(R3))GO TO 461
77300 JUMP .COMM.+4
77400 JUMPL H461
77410 SETOM IZ
77420 HX2: MOVE 5(R) ;GET PARAM 6
77460 CAMGE [10.0] ; MUST BE .GE.10
77470 JRST HX1
77480 MOVE IS,[2.44] ; SIZE OF A NOTE
77490 CAML [20.0] ; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
77500 MOVNS IS
77510 MOVM 3(R) ; GET P4
77520 CAML [100.0] ; IS IT A MINI?
77530 CAML [200.0]
77540 SKIPA
77550 FMPR IS,[0.6] ;*RMINI
77580 MOVE 1,.COMM.+3 ;STAFF #
77600 FMPR IS,STF+3(1) ;*RSTFAC(J2)
77610 FADR A,IS
77620 HX1: JUMPG IZ,HX8 ; JUMP TO CHANGE P6, 8 OR 9
77630 HX3: MOVEM A,.COMM.+4 ;R3=RD
77632 ; LOOKS FOR NOTE, STAFF #, STEM DIR.
77634 MOVN .COMM.+=14 ;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
77636 SKIPG ;IS IT NEG.
77638 JRST H11 ; NO, GO TO NEXT SECTION.
77640 MOVE IS,3(R) ; VERTICAL POS OF NOTE (P4)
77660 CAME [1.0] ;IS P13 -1 OR -2?
77670 JRST H12 ;IT'S -2
77680 MOVE [2.0]
77690 CAMGE JK,[20.0] ;WHICH WAY IS STEM?
77700 MOVNS
77705 FADR IS ;ADD NOTE LEVEL
77710 MOVEM .COMM.+5 ;P4=NOTE LEVEL + OR - 2.
77720 JRST H11
77730 H12: MOVE IZ,7(R) ; STEM LENGTH
77740 CAMN IZ,[999.0] ; WHAT ABOUT 16TH AND 32ND NOTES??
77750 SETZ IZ,
77760 FADR IZ,[8.0]
77764 JSA 16,AMOD
77766 JUMP 6(R)
77768 JUMP [10.0] ;AC0=AMOD(R7,10.0)
77769 SKIPN
77771 JRST H13
77773 FSBR [1.0] ;IGNORE 1ST TAIL
77774 FMPR [1.8] ; *SPACE FOR EACH TAIL
77776 FADR IZ, ; ADD TO STEM LENGTH
77784 H13: CAML JK,[20.0]
77786 MOVNS IZ ;PUT IT UPSIDE DOWN.
77790 FADR IS,IZ ;ADD NOTE LEVEL
77800 MOVEM IS,.COMM.+5 ;PUT IT BEYOND STEM
78020 H11: CAIN L,6 ;IF(JA.EQ.6)GO TO 861
78030 JRST H861
78040 CAIN L,5 ;IF(JA.EQ.5)GO TO 261
78100 JRST H261
78200 JRA 16,(16) ;RETURN
78400 H461: CAIN L,6 ;461 IF(JA.EQ.6)GO TO 277
78500 JRST H277
78600 CAIE L,5 ;IF(JA.NE.5)GO TO 361
78700 JRST HX361
78800 H277: JSA 16,PLACE ;277 IF(PLACE(R6))GO TO 561
78900 JUMP .COMM.+7
79000 JUMPL H561
79010 MOVEI IZ,7 ;R6=RD
79012 JRST HX2
79200 H861: MOVE 0,.COMM.+=28 ;861 IF(J7.GE.0)GO TO 261
79300 JUMPGE 0,H261
79400 H561: JSA 16,PLACE ;561 IF(PLACE(R9))GO TO 661
79500 JUMP .COMM.+=10 ;R9
79600 JUMPL H661
79700 MOVE 0,.COMM.+=28 ;IF(J7)GO TO 761
79800 JUMPL H761 ; J7=NEG MEANS TREMOLO
79900 MOVE 0,.COMM.+=9 ; IF(R8.NE.0)GO TO 761
80000 JUMPN H761
80100 MOVE 0,.COMM.+=11 ; IF(R10.EQ.0)GO TO 361
80200 JUMPE HX361
80210 H761: MOVEI IZ,=10 ;761 R9=RD
80230 JRST HX2
80400 ; R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM. ; GO TO 261
80600 H661: CAIN L,5 ;661 IF(JA.EQ.5)GO TO 361
80700 JRST HX361
80800 MOVE 0,.COMM.+=31 ;IF(J10.LT.30)GO TO 361
80900 CAIGE 0,=30
81000 JRST HX361
81100 JSA 16,PLACE ;IF(PLACE(R8))GO TO 361
81200 JUMP .COMM.+=9
81300 JUMPL HX361 ; HOMES INNER PARTIAL BEAMS
81310 MOVEI IZ,=9 ;R8=RD
81330 JRST HX2
81400 HX8: MOVEM A,.COMM.(IZ) ;PUT A INTO RIGHT PARAM.
81500 H261: SKIPN RC ;261 IF(RC.EQ.0)RETURN
81600 JRA 16,(16)
81700 AOJ RC ;RC=RC+1
81800 HX361: CAMGE K,PTR+=250 ;361 CONTINUE
81900 AOJA K,H361
82000 JRA 16,(16) ; END
82100
82200 ; CALL FSCAN
82300 ; GOTO RT
82400 ; GOTO LF
82500 ; GOTO UP
82600 ; GOTO DW
82700 ; GOTO 1/2
82800 ; GOTO *2
82900 ; GOTO X
83000 ; GOTO C
83100 ; ALL OTHERS(EXIT)
83200
83300 FSCAN: 0
83400 INCHRW
83420 MOVE 2,[ASCII/ /]
83430 MOVEM 2,ALF
83440 MOVE 2,[XWD ALF,ALF+1]
83470 BLT 2,ALF+=71 ; CLEANS OUT INP ARRAY
83500 CAIN ";"
83600 JRA 16,(16)
83700 CAIN ":"
83800 JRA 16,1(16)
83900 CAIN "("
84000 JRA 16,2(16)
84100 CAIN ")"
84200 JRA 16,3(16)
84300 CAIN "/"
84400 JRA 16,4(16)
84500 CAIN "*"
84600 JRA 16,5(16)
84700 CAIN "X"
84800 JRA 16,6(16)
84900 CAIN "C"
85000 JRA 16,7(16)
85100 JRA 16,8(16)
85200
87000
87100 NALF: 0
87200 MOVE 0,@(16)
87300 JUMPGE .+4 ;IF(I.GE.0)GO TO 20
87400 MOVE 1,[405004020100] ; J='A'=405004020100
87500 SETO 2, ; M=-1
87600 JRST .+3 ;GO TO 10
87700 MOVE 1,[201004020100] ;20 J=' '=201004020100
87800 MOVEI 2,=16 ; M=16
87900 SUB 0,1 ;10 NALF=(I-J)/536870912-M
88000 IDIV 0,[3777777777]
88100 SUB 0,2
88200 JRA 16,1(16)
88300
88400 BOX: 0 ;CALL BOX(I,R) SEE PLTSRT.F4 FOR FORTR. VERSION
88500 MOVE 14,@(16) ; I IS IN 14
88600 JUMPL 14,BX4
88700 MOVE 13,@1(16) ; GET R
88800 FIXX(13) ; K=R
88900 JSA 16,AMOD
89000 JUMP XRN+3(14) ; GET REAL P4
89100 [100.0]
89200 FMPR [7.0]
89300 FMPR STF+3(13) ;*STAFF FACTOR
89400 FADR POSI+3(13) ; + STAFF VERT. POS.
89500 FSBR [40.0] ; SHIFT CURSOR DOWN A BIT.
89600 FMPR SIZ
89610 MOVE 13,
89655 FIXX(13)
89700 SUB 13,SIZ+2 ;13=K
89900 JSA 16,RHORZ ; GET HORIZ. POS.
90000 JUMP XRN+2(14)
90100 FMPR SIZ ;SIZ IS FOR ZOOMED IMAGES
90110 MOVE 12, ; 12=L
90155 FIXX(12)
90200 SUB 12,SIZ+1
90400 CAIL 12,=550 ; CHECK IF OUT OF BOUNDS OF CRT
90500 MOVEI 12,=511
90600 CAMG 12,[-=550]
90700 MOVE 12,[-=511]
90800 JSA 16,SETCUR
90900 12
91000 13
91010 [0]
91100 JRA 16,2(16) ; THE CURSOR IS IN POSITION
91200 BX4: CAME 14,[-1]
91300 JRST BX5
91400 JSA 16,DPYSET
91500 [3]
91600 RINP
91700 [=100]
91800 JSA 16,DPYBRT
91900 [3]
92000 BX5: MOVE 2,@1(16) ; GET R
92100 JSA 16,RHORZ
92200 2
92300 FMPR SIZ
92350 FIXX(0)
92400 SUB SIZ+1
92500 MOVM 2,
92600 CAILE 2,=550
92700 JRST BX6
92750 MOVEM 0,LOOP
92800 JSA 16,SETPOG
92900 [3]
93000 JSA 16,ALINE
93100 LOOP
93200 [-=511]
93300 LOOP
93400 [=511]
93500 JSA 16,DPYOUT
93600 [3]
93700 BX6: JSA 16,SETPOG
93800 [1]
93900 JRA 16,2(16)
94000
94100 END